Shareware Grab Bag/Shareware Grab Bag.iso/003/dbiiicol.arc/DBIIICOL.PRG

Text File | 1985-10-19 | 10.5 KB | 357 lines

*                COLOR.PRG AND PERSONALIZATION PROGRAM
*    WRITTEN BY: GLENN E. MERIDETH  201-262-9559
*    EXTRACTED FROM UTILITY.PRG
*       MAIN PROGRAM WILL NEED TO MAKE ALLOWANCES FOR A NEW SYSTEM THAT
*    DOES NOT HAVE ANY COLOR INFORMATION , SUCH AS THE FOLLOWING:

PUBLIC PSSF,PSSB,PSEF,PSEB,PSBD

*    THE BELOW LINES READ IN OLD COLOR AND PERSONAL INFORMATION OR SET UP
* DEFAULT VALUES. THIS WOULD NORMALLY BE IN  THE MAIN DBIII PROGRAM WITH
* AN OPTION TO CALL A UTILITY MENU WHERE THE COLOR/PERSONAL PROGRAMS ARE
*******************      MAIN  MENU    INTRO **********************

  IF FILE("CSGPERS.MEM")
     RESTORE FROM CSGPERS ADDITIVE
  ELSE

*    SET UP DEFAULT COLOURS

     PSSF = "+6"
        * STANDARD FORGROUND COLOR
     PSSB = "1"
        * STANDARD BACKGROUND COLOR
     PSEF = "+2"
        * ENHANCED FORGROUND COLOR
     PSEB = "0"
        * ENHANCED BACKGROUND COLOR
     PSBD = "1"
        * BORDER COLOR

*    SET UP DEFAULT VALUES FOR PERSONALIZATION

     STORE "Y" TO PSAUTO,PSBELL,PSVIDEO
    ENDIF

*    SET UP CONFIRM, BELL, INVERSE ACCORDING TO DEFAULT OR *.MEM FILE

        IF PSAUTO = "Y"
          SET CONFIRM OFF
          ELSE
          SET CONFIRM ON
        ENDIF
        IF PSBELL = "Y"
          SET BELL ON
          ELSE
          SET BELL OFF
        ENDIF
        IF PSVIDEO = "N"
          SET DELIMITERS ON
          SET DELIMITERS TO "[]"
          SET INTENSITY OFF
        ELSE
          SET DELIMITERS OFF
          SET INTENSITY ON
     ENDIF

SET COLOR TO &PSSF/&PSSB,&PSEF/&PSEB,&PSBD

*    COLOUR UTILITY WHICH IS CALLED FROM MAIN MENU

*    PSSF = STANDARD FORGROUND
*    PSSB = STANDARD BACKGROUN
*    PSEF = ENHANCED FORGROUND
*    PSEB = EHNANCED BACKGROUN
*    PSBD = BORDER

CASE UPPER(U_choice) = "C"
  clear

*    ASSIGN FIXED VALUES FOR THIS PROGRAM SO ONE CANNOT SET THE COLOURS
*    SO ONE CANNOT READ THE SCREEN

  PSSF = "+6"
*    +6 = high intensity yellow
  PSSB = "1"
*    1 = blue background
  PSEF = "+2"
*    +2 = high intensity green
  PSEB = "0"
*    0 = black background
  PSBD = "1"
*    1 = blue border

  SET COLOR TO &PSSF/&PSSB,&PSEF/&PSEB,&PSBD
  again = "Y"
     do while upper(again)="Y"
        CLEAR

*    PRESENT THE AVAILABLE COLOURS SO USER CAN SEE INSTEAD OF GUESSING
*    WHAT A COLOUR IS

        set color to +1/0
        @ 17,5 say " +1 HIGH  "
        SET COLOR TO 1/0
        @ 18,5 SAY " 1 NORMAL "
        SET COLOR TO +2/0
        @ 19,5 SAY " +2 HIGH  "
        SET COLOR TO 2/0
        @ 20,5 SAY " 2 NORMAL "
        SET COLOR TO +3/0
        @ 17,20 SAY " +3 HIGH  "
        SET COLOR TO 3/0
        @ 18,20 SAY " 3 NORMAL "
        SET COLOR TO +4/0
        @ 19,20 SAY " +4 HIGH  "
        SET COLOR TO 4/0
        @ 20,20 SAY " 4 NORMAL "
        SET COLOR TO +5/0
        @ 17,35 SAY " +5 HIGH  "
        SET COLOR TO 5/0
        @ 18,35 SAY " 5 NORMAL "
        SET COLOR TO +6/0
        @ 19,35 SAY " +6 HIGH  "
        SET COLOR TO 6/0
        @ 20,35 SAY " 6 NORMAL "
        SET COLOR TO +7/0
        @ 17,50 SAY " +7 HIGH  "
        SET COLOR TO 7/0
        @ 18,50 SAY " 7 NORMAL "
        SET COLOR TO 0/1
        @ 19,50 SAY " 0 NORMAL "
        SET COLOR TO *0/1
        @ 20,50 SAY " *0 BLINK"
        SET COLOR TO +6/1,+2/0,&PSBD
        SET COLOR TO &PSSF/&PSSB

*    LET USER KNOW WHAT THE PRESENT CHOICES ARE SO IF THEY WANT TO MAKE
*    A CHANGE THEY DON'T NEED TO REMEMBER WHAT THE LAST COLOUR WAS

        @ 22,5 SAY "FORGROUND"
        @ 22,16 SAY PSSF
        @ 22,20 SAY "BACKGROUND"
        @ 22,33 SAY PSSB
        @ 23,5 SAY " PRIOR SELECTION NORMAL TEXT "
        SET COLOR TO &PSEF/&PSEB
        @ 22,45 SAY "FORGROUND"
        @ 22,56 SAY PSEF
        @ 22,60 SAY "BACKGROUND"
        @ 22,73 SAY PSEB
        @ 23,45 SAY " PRIOR SELECTION DATA ENTRY  "
        SET COLOR TO +6/1
        @ 24,33 SAY " BORDER = "
        @ 24,44 SAY PSBD

*    PROVIDE THE USER WITH INSTRUCTIONS

        @ 0,5 SAY "You can SELECT CERTAIN COLOURS from thes program. Some colours CANNOT"
        @ 1,5 SAY "be changed, i.e. the warning messages. You will be able to change until"
        @ 2,5 SAY "you enter < Q >. The allowable colours and modes are : "
        @ 3,5 say "BLACK = 0   BLUE = 1     GREEN = 2     CYAN = 3   RED = 4  MAGENTA = 5"
        @ 4,5 SAY "BROWN = 6   WHITE = 7    HIGH INTENSITY = +       BLINKING = *"
        @ 5,5 SAY "HIGH INTENSITY and/or BLINKING do not work on the background colours. You"
        @ 6,5 say "cannot BLINK the border. Enter a number and press <RETURN>, -or- <SPACE>"
        @ 7,5 SAY "<RETURN> to keep current choice. Present choices are at the bottom of the"
        @ 8,5 SAY "Screen. On a monochrome monitor only, < U > = underline. Happy colouring."
        ?

*    TRANSFER LAST CHOICE INTO A TEMPORATY VARIABLE

        TEMP = PSSF

*    CLEAR VARIABLE

        PSSF = ''

*    INSURE USER ONLY ENTERS VALID VALUES, I.E. <+> OR <*> ONLY WITH THE
*    FIRST NUMBER AND LIMIT THE NUMBERS TO 0-7 AND <U>, OR ' '

        DO WHILE .NOT. SUBSTR(PSSF,1,1) $ ' +*01234567U'(.OR. .NOT. SUBSTR(PSSF,2,1) $ '01234567U')
          @ 9,0 SAY ''
          accept "   enter FORGROUND (this is forground) colour  " to PSSF

*    IF NOT <+> OR <*> THEN CHECK FOR VALID ENTRY

             IF LEN(PSSF)=1 .AND. .NOT. (SUBSTR(PSSF,1,1) $ ' 01234567U')
               PSSF = ''
             ENDIF
        ENDDO

*    DOES USER WANT TO CONTINUE WITH PRIOR ENTRY

        IF PSSF = " "
           PSSF=TEMP
        ENDIF
     SET COLOR TO &PSSF/&PSSB,,&PSBD

*    LET USER KNOW WHAT THEY HAVE CHOOSEN

     @ 10,55 say " FORGROUND "
     SET COLOR TO +6/1,+2/0,&PSBD

*       AND REPEAT....

     TEMP = PSSB
     PSSB = ''
        DO WHILE .NOT. PSSB $ ' 01234567'
           @ 10,0 SAY ''
           ACCEPT "   enter BACKGROUND (the overall screen colour) " to PSSB
              IF LEN(PSSF)=1 .AND. .NOT. (SUBSTR(PSSF,1,1) $ ' 01234567U')
                 PSSB = ''
              ENDIF
        ENDDO
              IF PSSB =' '
                 PSSB=TEMP
              ENDIF
     SET COLOR TO &PSSF/&PSSB,,&PSBD
     @ 11,55 SAY " BACKGROUND "
     SET COLOR TO +6/1,+2/0,&PSBD
     TEMP = PSEF
     PSEF = ''
        DO WHILE .NOT. SUBSTR(PSEF,1,1) $ ' +*01234567U'(.OR. .NOT. SUBSTR(PSEF,2,1) $ '01234567U')
           @ 11,0 SAY ''
           ACCEPT "   enter DATA ENTRY FORGROUND (the box words)    " to PSEF
              IF LEN(PSEF)=1 .AND. .NOT. (SUBSTR(PSEF,1,1) $ ' 01234567U')
                 PSEF = ''
              ENDIF
        ENDDO
        IF PSEF = ' '
           PSEF=TEMP
        ENDIF
     SET COLOR TO &PSEF/&PSEB,,&PSBD
     @ 12,55 SAY " DATA ENTRY FORGROUND "
     SET COLOR TO +6/1,+2/0,&PSBD
     TEMP = PSEB
     PSEB = ''
        DO WHILE .NOT. PSEB $ ' 01234567'
           @ 12,0 SAY ''
           ACCEPT "   enter DATA ENTRY BACKGROUND (the box outline) " to PSEB
              IF LEN(PSSF)=1 .AND. .NOT. (SUBSTR(PSSF,1,1) $ ' 01234567U')
                 PSEB = ''
              ENDIF
        ENDDO
        IF PSEB = ' '
           PSEB = TEMP
        ENDIF
     SET COLOR TO &PSEF/&PSEB,,&PSBD
     @ 13,55 SAY " DATA ENTRY BACKGROUND "
     SET COLOR TO +6/1,+2/0,&PSBD
     TEMP = PSBD
     PSBD = ''
        DO WHILE .NOT. PSBD $ ' 01234567'
           @ 13,0 SAY ''
           ACCEPT "   enter BORDER colour (the colour on the edges) " to PSBD
              IF LEN(PSSF)=1 .AND. .NOT. (SUBSTR(PSSF,1,1) $ ' 01234567U')
                 PSBD = ''
              ENDIF
        ENDDO
        IF PSBD = ' '
           PSBD = TEMP
        ENDIF
     SET COLOR TO +6/1,+2/0,&PSBD

*    CHECK TO SEE IF USER HAS SET SET BOTH COLOURS THE SAME AND FORCE
*    THEM TO GO BACK

        IF PSSF=PSSB .OR. PSEF=PSEB
           SET COLOR TO +4/0
           @ 15,20 SAY "YOU CANNOT HAVE BOTH SELECTIONS THE SAME"
           WAIT
           SET COLOR TO +6/1,+2/0,&PSBD
        ELSE
           wait "                      any more changes  Y/N  " to again
        ENDIF
  ENDDO

*    SAVE VALUES TO *.MEM

SET SAFETY OFF
SAVE ALL LIKE  PS* TO CSGPERS
SET SAFETY ON

*    PERSONALIZATION MENU, CALLED FROM MAIN MENU VIA UTILITY MENU

CASE UPPER(U_choice) = "P"
  CLEAR

*    RESTORE VALUES IF THEY EXIST

     IF FILE("CSGPERS.MEM")
        RESTORE FROM CSGPERS
     ELSE
        STORE "N" TO PSVIDEO,PSBELL,PSAUTO
     ENDIF
  @ 0,2 SAY "+++++++++++++++++++++++++++++++++++++++++++++++++++++++"
  @ 0,57 SAY "++++++++++++++++++++++"
  @ 1,2 SAY "+"
  @ 1,78 SAY "+"
  @ 2,2 SAY "+                   P E R S O N A L I Z A T I O N    M"
  @ 2,57 SAY "E N U                +"
  @ 3,2 SAY "+"
  @ 3,78 SAY "+"
  @ 4,2 SAY "+++++++++++++++++++++++++++++++++++++++++++++++++++++++"
  @ 4,57 SAY "++++++++++++++++++++++"
  @ 6,22 SAY "ALL RESPONES REQUIRE  ( Y/N )  ANSWER"

  STORE ' ' TO CHANGE
     DO WHILE .NOT. (UPPER(CHANGE) $'N')
           @ 10,0 clear
           STORE " " TO PERS

*    USER WANT BELL AT END OF DATA ENTRY FIELD ?

              DO WHILE .NOT. (UPPER(PERS) $ 'YN')
                 ?   "                  OLD VALUE IS : " + PSBELL
                 WAIT"                  SET BELL AT END OF FIELD " TO PERS
              ENDDO
           STORE PERS TO PSBELL
           STORE ' ' TO PERS

*    USER WANT AUTO-RETURN AT END OF DTA ENTRY FIELD ?

           DO WHILE .NOT. (UPPER(PERS) $ 'YN')
                 ? "                    OLD VALUE IS : " + PSAUTO
                 WAIT"            SET AUTO RETURN AT END OF FIELD " to pers
           ENDDO
        STORE PERS TO PSAUTO
        STORE ' ' TO PERS

*    HOW DOES USER WANT TO SEE DATA ENTRY ?

        ? "        (N = [ ] used to outline field)"
           DO WHILE .NOT. (UPPER(PERS) $ 'YN')
              ? "                    OLD VALUE IS : " + PSVIDEO
              wait"               SET FIELDS TO REVERSE VIDEO " to pers
           ENDDO
         STORE PERS TO PSVIDEO
           WAIT "                             MAKE ANY CHANGES " TO CHANGE
  ENDDO

*    SET UP SYSTEM PER USER CHOICES

  IF PSAUTO = "Y"
     SET CONFIRM ON
  ELSE
     SET CONFIRM OFF
  ENDIF
  IF PSBELL = "Y"
     SET BELL ON
  ELSE
     SET BELL OFF
  ENDIF
     IF PSVIDEO = "N"
     SET DELIMITERS ON
     SET DELIMITERS TO "[]"
     SET INTENSITY OFF
  ELSE
     SET DELIMITERS OFF
     SET INTENSITY ON
  ENDIF

*    SAVE OUT TO *.MEM

SET SAFETY OFF
SAVE ALL LIKE  PS* TO CSGPERS
SET SAFETY ON

*END